home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / U. Mass AI & LISP Tools / UTILITY / CONTROL.lisp < prev    next >
Encoding:
Text File  |  1990-06-25  |  5.0 KB  |  108 lines  |  [TEXT/MACA]
  1. ; (c) Copyright 1990 by University of Massachusetts. All rights reserved.
  2. ; This software was conceived, designed, and written by Dan Suthers 
  3. ; while supported by the National Science Foundation under grant number
  4. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  5. ; CA.  Partial support was also received from the Office of Naval Research
  6. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  7. ; Mr. Suthers created this software under his own initiative while in an 
  8. ; academic relationship with the University of Massachusetts.  The above
  9. ; copyright notice was a condition placed by University lawyers on approval
  10. ; of distribution of this software by Apple Computer, and is not meant to
  11. ; imply that this software was created in an employment or "work for hire"
  12. ; relationship between the University and Mr. Suthers.
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; File:         CONTROL.lisp
  15. ; Author:       Dan Suthers
  16. ; Created:      16-Jun-88 10:37:12
  17. ; Modified:     22-Jun-90 02:08:13 (Dan Suthers)
  18. ; Language:     Common Lisp
  19. ; Package:      UTILS
  20. ;
  21. ; Description:  Additional control constructs.
  22. ;
  23. ; (c) Copyright 1988, by Daniel D. Suthers
  24. ;                        Department of Computer and Information Science
  25. ;                        University of Massachusetts
  26. ;                        Amherst, Massachusetts 01003
  27. ;
  28. ; This software was conceived, designed, and written by Dan Suthers 
  29. ; while supported by the National Science Foundation under grant number
  30. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  31. ; CA.  Partial support was also received from the Office of Naval Research
  32. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  33. ; I wish to acknowledge the generous support of Beverly Woolf, who obtained 
  34. ; the above grants and encouraged me to pursue my own research interests in
  35. ; her lab.  This work would not have been possible without the resources and
  36. ; stimulating environment of the Computer and Information Science department.
  37. ;
  38. ; Permission to use, modify, and distribute this software is granted subject 
  39. ; to the following restrictions and understandings:
  40. ; 1. The file header, including this notice, shall be retained, and may be
  41. ;    extended to include documentation of modifications to the software.
  42. ; 2. This material is for nonprofit educational and research purposes only.
  43. ;    Users are requested, but not required, to inform Mr. Suthers of any 
  44. ;    noteworthy uses of this software.
  45. ; 3. Mr. Suthers and the University of Massachusetts make no warrantee or
  46. ;    representation that the operation of this software will be error free,
  47. ;    and are under no obligation to provide any services.
  48. ; 4. Any user of such software agrees to indemnify and hold harmless Mr.
  49. ;    Suthers and the University of Massachusetts from all claims arising 
  50. ;    out of the use or misuse of this software, or arising out of any 
  51. ;    accident, injury, or damage whatsoever, and from all costs, counsel
  52. ;    fees, and liabilities incurred in or about any such claim, action, or
  53. ;    proceeding brought thereon.
  54. ; 5. All materials and reports developed as a consequence of the use of 
  55. ;    this software shall duly acknowledge such use, in accordance with
  56. ;    the usual standards of acknowledging credit in academic research.
  57. ;
  58. ; Status: Done and tested.
  59. ;
  60. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61.  
  62. (in-package :UTILS)
  63.  
  64. (export '(
  65.           insist
  66.           pause
  67.           random-choice
  68.           ))
  69.  
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71.  
  72. ;;; This needs rewrite to use gensym.
  73.  
  74. (defmacro INSIST (&rest body)
  75.   "insist <form> ...                                                   [Macro]
  76.   Evaluates a body of forms until the last one returns a non-nil value."
  77.   `(do (($$result$$ nil))
  78.        ($$result$$ $$result$$)
  79.      (setf $$result$$
  80.        (progn ,@body))))
  81.  
  82. (defun PAUSE (&optional (stream T) escape-char)
  83.   "pause &optional <stream> <escape-char>                          [Function]
  84.   Pauses output to stream, asking the user to type Return to continue.
  85.   Stream defaults to T.  If <escape-char> is specified, PAUSE will also 
  86.   tell the user to type <escape-char> to quit, and THROW <escape-char>
  87.   to :escape-pause if it is read. NOTE: <escape-char> must be a character!"
  88.   (if escape-char
  89.       (progn
  90.         (format stream "~%(Return to continue, ~S to quit):" escape-char)
  91.         (if (equal (read-char stream) escape-char)
  92.             (throw :escape-pause escape-char)))
  93.       (progn
  94.         (format stream "~%(Return to continue):")
  95.         (read-char stream) )))
  96.  
  97. (defmacro RANDOM-CHOICE (options)
  98.   "random-choice <options>                                             [Macro]
  99.   Randomly chooses one of the elements of the list <options> evaluates to."
  100.   `(let ((options ,options))
  101.      (if options
  102.          (nth (random (length options)) options))))
  103.  
  104. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105. (provide :CONTROL)
  106. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  107. ;;; EOF
  108.